%%%-------------------------------------------------------------------
%%% File        : smtpc.erl
%%% Author      : Fyodor Ustinov <ufm@ufm.su>
%%% Description : MailEr  project
%%%               Server part SMTPC module
%%%
%%% Created     :  7 Sep 2009 by Fyodor Ustinov <ufm@ufm.su>
%%%-------------------------------------------------------------------
-module(smtpc).
-behaviour(gen_server).

%% API
-export([start_link/1]).

%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
	 terminate/2, code_change/3]).

%-include("smtpc.hrl").
-include_lib("kernel/src/inet_dns.hrl").
-include_lib("kernel/include/inet.hrl").

-record(s, {fsm = 0,           % FSM part
	    mail = 0,          % Message
	    mxs = [],          % MXs list
	    mx = {},           % Current MX
            mxansv = [],       % State of MXs
	    port = {},         % Opened port
	    status = none,     % delayed | permanent | sent
	    rc = "",           % Answer code
	    data = [],         % Answer data
	    attr = dict:new(), % Parsed ehlo
	    d = [],            % md5 temp
	    fallback = off,    % fallback servers
	    login = {},        % login info
	    ssubst = [],       % Saved substitutions
	    subst = []         % Substitutions
	   }).

-define(EVENT(X), gen_fsm:send_event(S#s.fsm, X)).
-define(GENEVENT(X), gen_fsm:send_all_state_event(S#s.fsm, X)).
-define(config_get(X, Y), config:get(smtpc, X, Y)).
-define(sconfig_get(S, X, Y), config:get(S#s.subst, smtpc, X, Y)).


%%--------------------------------------------------------------------
%%% 
%%--------------------------------------------------------------------




%%====================================================================
%%% API for gen_server
%%====================================================================

start_link(F) ->
    gen_server:start_link(?MODULE, [F], []).


init([F]) ->
%% MOVE TO SYSTEN INIT!!!!!!!!!!!!
    ssl:start(),
    ssl:seed(erlang:term_to_binary(now())),
    [inet_db:add_ns(X) || X <- ?config_get(dns,[])],
%%%%%%%%%%%%%%%%%
    {ok, Fsm} = smtpcfsm:start_link(self()),
    gen_fsm:send_event(Fsm, start),
    {ok, #s{fsm = Fsm, mail = F}}
.

%%--------------------------------------------------------------------
%%% Ask configuration
%%--------------------------------------------------------------------

handle_call({Request, Default}, _From, S) ->
    Reply = ?sconfig_get(S, Request, Default),
    {reply, Reply, S}.

%%--------------------------------------------------------------------
%% Function: handle_cast(Msg, State) -> {noreply, State} |
%%                                      {noreply, State, Timeout} |
%%                                      {stop, Reason, State}
%% Description: Handling cast messages
%%--------------------------------------------------------------------

%%--------------------------------------------------------------------
%%% PrepareMX
%%--------------------------------------------------------------------

handle_cast('PrepareMX', S) ->
Rcpt = "ufmufm@gmail.com",
RcptDomain = "gmail.com",
%    {ok, {_, RcptDomain}} = (S#s.mail)(get_rcptto,[]),
    D1 = lists:ukeysort(1, config:subst(smtpc, Rcpt, substitute)),
    S1 = S#s{ssubst = D1, subst = D1},
    FB = ?sconfig_get(S1, fallback_server, off),
    S2 = S#s{fallback = FB},
    case ?sconfig_get(S2, mx, mx) of
	mx -> % Get list of MXs by DNS
	    case get_dest_mx(RcptDomain) of
		{ok, MXs} ->
		    Sn = S2#s{mxs = MXs},
		    ?EVENT(ok);

		false ->
		    case S2#s.fallback of
			off ->
			    ?EVENT(nomx);

			FB ->
			    ?EVENT(ok)
		    end,
		    Sn = S2#s{mxs = []}
	    end;

	MXs -> % Ready list of MX
	    ?EVENT(ok),
	    Sn = S2#s{mxs = MXs}
    end,
io:format("MXs == '~p'~n",[Sn#s.mxs]),
    {noreply, Sn}
;

%% ------------------------------------------------
%%% MX?
%%-------------------------------------------------

handle_cast('MX?', S) ->
io:format("MX?~n"),
    close_port(S),
    case S#s.mxs of
	[MX | T] ->
	    D1 = lists:ukeysort(1, config:subst(smtpc, MX, substitute)),
	    D2 = lists:ukeysort(1, lists:keymerge(1, D1, S#s.ssubst)),
	    Sn = S#s{port = {}, subst = D2, mx = MX, mxs = T},
	    ?EVENT(ok);

	[] ->
	    Sn = case S#s.fallback of
		     [MX | T] ->
			 D1 = lists:ukeysort(1, config:subst(smtpc, MX, substitute)),
			 D2 = lists:ukeysort(1, lists:keymerge(1, D1, S#s.ssubst)),
			 ?EVENT(ok),
			 S#s{port = {}, subst = D2, mx = MX, fallback = T};
		     
		     [] ->
			 ?EVENT(nomx),
			 S#s{port = {}, mx = []};
		     off ->
			 ?EVENT(nomx),
			 S#s{port = {}, mx = []}
		 end
    end,
    {noreply, Sn}
;


%%--------------------------------------------------------------------
%%% Open ssl/nossl port
%%--------------------------------------------------------------------

handle_cast(open_ssl, S) ->
io:format("SSL [~s]",[S#s.mx]),
    case ssl:connect(S#s.mx, ?sconfig_get(S, ssl_smtp_port, 465), 
		     [binary, {keepalive, true},
		      {packet, line}, {active, once},
		      {verify, ?sconfig_get(S, ssl_verify_level, 0)}],
		     ?sconfig_get(S, connection_timeout, 300) * 1000) of
	{ok, Port} ->
io:format(" ok.~n"),
	    Sn = S#s{port = {ssl, Port}};
	
	_ ->
io:format(" unable.~n"),
	    ?EVENT({ssl, unable}),
	    Sn = S
    end,
    {noreply, Sn}
;

handle_cast(open_nossl, S) ->
    case gen_tcp:connect(S#s.mx, ?sconfig_get(S, smtp_port, 25),
			 [binary, {keepalive, true}, 
			  {packet, line}, {recbuf, 1024},
			  {active, once}, {send_timeout, ?sconfig_get(S, send_timeout, 300) * 1000}],
			 ?sconfig_get(S, connection_timeout, 300) * 1000) of
	{ok, Port} ->
	    Sn = S#s{port = {gen_tcp, Port}};

	_ ->
	    ?EVENT({nossl, unable}),
	    Sn = S
    end,
    {noreply, Sn}
;
    
%% ------------------------------------------------
%%% EHLO / HELO
%%-------------------------------------------------

handle_cast(ehlo, S) ->
    send(S, "EHLO " ++ ?sconfig_get(S, myhostname, "localhost") ++ "\r\n"),
    {noreply, S#s{rc = "", data = []}}
;

handle_cast(helo, S) ->
    send(S, "HELO " ++ ?sconfig_get(S, myhostname, "localhost") ++ "\r\n"),
    {noreply, S#s{rc = "", data = []}}
;

handle_cast('parse ehlo', S) ->
    {noreply, parse_ehlo(S)}
;

%% ------------------------------------------------
%%% LOGIN? 
%%-------------------------------------------------

handle_cast('login?', S) ->
    S2 = try
	     AM = case S#s.port of
		      {ssl, _} ->
			  lists:nth(1,intersect(?sconfig_get(S, ssl_auth_priority,[]), dict:find(auth, S#s.attr)));
		      
		      _ ->
			  lists:nth(1,intersect(?sconfig_get(S, auth_priority,[]), dict:find(auth, S#s.attr)))
		  end,
	     case ?sconfig_get(S, login, off) of
		 off ->
		     ?EVENT(mailfrom),
		     S#s{login = {}};
		 
		 sender -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		     ?EVENT(AM),
		     S#s{login = {"Username", "Password"}};
		 
		 {U, P} ->
		     ?EVENT(AM),
		     S#s{login = {U, P}}
	     end
	 catch
	     _ : _ ->
		 ?GENEVENT(permanent_error),
		 S
	 end,
    {noreply, S2#s{rc ="", data = []}}
;
%% ------------------------------------------------
%%% AUTH PLAIN
%%-------------------------------------------------

handle_cast('auth plain', S) ->
    {User, Password} = S#s.login,
    send(S, <<"AUTH PLAIN ">>), 
    send(S, plain_encode(User, Password)),
    send(S, <<"\r\n">>),
    {noreply, S#s{rc = "", data = []}}
;    

%% ------------------------------------------------
%%% AUTH LOGIN
%%-------------------------------------------------

handle_cast('auth login', S) ->
    {User, _Password} = S#s.login,
    send(S, <<"AUTH LOGIN ">>),
    send(S, base64:encode(User)),
    send(S, <<"\r\n">>),
    {noreply, S#s{rc = "", data = []}}
;

handle_cast('password base64', S) ->
    {_User, Password} = S#s.login,
    send(S, base64:encode(Password)),
    send(S,<<"\r\n">>),
    {noreply, S#s{rc = "", data = []}}
;

%% ------------------------------------------------
%%% AUTH DIGEST-MD5
%%-------------------------------------------------

handle_cast('auth digest-md5', S) ->
    send(S, <<"AUTH DIGEST-MD5\r\n">>),
    {noreply, S#s{rc = "", data = []}}
;


handle_cast('digest-md5 decode and ansver', S) ->
    {User, Password} = S#s.login,
    [D] = S#s.data,
    Md5 = mlib:decode_digest_md5(D),
    A1 = mlib:encode_digest_md5(User, Password, "AUTHENTICATE", Md5),
    Ans = string:join([X ++ "=" ++ Y || {X, Y} <- A1],","),
    St = base64:encode_to_string(Ans),
    A2 = mlib:decode_digest_md5(St),
    send(S, St),
    send(S, <<"\r\n">>),
    {noreply, S#s{d = A2, rc = "", data = []}}
;

handle_cast('digest-md5 check ansver', S) ->
    {User, Password} = S#s.login,
    {_, D} = lists:split(8,base64:decode_to_string(lists:nth(1,S#s.data))),
    {value, {"response", Ans}} = lists:keysearch("response", 1, mlib:encode_digest_md5(User, Password, [], S#s.d)),
    if
	D =:= Ans ->
	    send(S, <<"\r\n">>);
	true ->
	    ?GENEVENT(permanent_error)
    end,
    {noreply, S#s{d = [], rc = "", data = []}}
;

%% ------------------------------------------------
%%% AUTH CRAM-MD5
%%-------------------------------------------------

handle_cast('auth cram-md5', S) ->
    send(S, <<"AUTH CRAM-MD5\r\n">>),
    {noreply, S#s{rc = "", data = []}}
;

handle_cast('cram-md5 decode and ansver', S) ->
    {User, Password} = S#s.login,
    D = base64:decode_to_string(lists:nth(1,S#s.data)),
    PPass = mlib:pad_to(Password, 0, 64),
    A = erlang:md5([X bxor 16#5c || X <- PPass] ++ binary_to_list(erlang:md5([X bxor 16#36 || X <- PPass] ++ D))),
    send(S, base64:encode(User ++ " " ++ mlib:bin_to_hex(A))),
    send(S, <<"\r\n">>),
    {noreply, S#s{d = [], rc = "", data = []}}
;

%% ------------------------------------------------
%%% MAIL FROM:
%%-------------------------------------------------


handle_cast(mailfrom, S) ->
Size = 2048000, %%%%%%%%%%%%%%%%%%%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    send(S, "MAIL FROM:<ufm@ufm.su>"),
    dict:is_key(size, S#s.attr) =:= true andalso
	send(S, " SIZE=" ++ erlang:integer_to_list(Size)),
    send(S, "\r\n"),
    {noreply, S#s{rc = "", data = []}}
;

%% ------------------------------------------------
%%% RCPT TO:
%%-------------------------------------------------


handle_cast(rcptto, S) ->
    send(S, "RCPT TO:<ufmufm@gmail.com>\r\n"),
    {noreply, S#s{rc = "", data = []}}
;

%% ------------------------------------------------
%%% DATA
%%-------------------------------------------------

handle_cast(data, S) ->
    send(S, "DATA\r\n"),
    {noreply, S#s{rc = "", data = []}}
;

%% ------------------------------------------------
%%%
%%-------------------------------------------------

handle_cast(permanent_error, S) ->
    io:format("Permanent error.~n"),
    ?EVENT(ok),
    {stop, normal, S}
;

handle_cast(internal_error, S) ->
    io:format("Internal error!~n"),
    ?EVENT(ok),
    {stop, normal, S}
;

handle_cast({delay, Reason}, S) ->
    io:format("Delay message: ~p~n",[Reason]),
    ?EVENT(ok),
    {stop, normal, S}
;

handle_cast(close, S) ->
    {Mod, Port} = S#s.port,
    Mod:close(Port),
    {noreply, S#s{port = {}, rc = "", data = []}}
;

handle_cast(timeout, S) ->
    close_port(S),
    ?EVENT(ok),
    {noreply, S#s{rc = "", data = [], port = {}}}
;

handle_cast(_Msg, State) ->
    {noreply, State}.

%% ------------------------------------------------
%%% TCP Flow
%%-------------------------------------------------

handle_info({tcp_closed, _}, S) ->
    ?GENEVENT(tcp_closed),
    {noreply, S}
;

handle_info({tcp, _, D}, S) ->
io:format("TCP: D == ~p~n",[D]),
    Sn = parse_data(S, D),
    enable_flow(Sn),
    {noreply, Sn}
;


%% ------------------------------------------------
%%% SSL Flow
%%-------------------------------------------------


handle_info({ssl_closed, _}, S) ->
    ?GENEVENT(tcp_closed),
    {noreply, S}
;

handle_info({ssl, _, D}, S) ->
io:format("SSL: D == ~p~n",[D]),
    Sn = parse_data(S, D),
    enable_flow(Sn),
    {noreply, Sn}
;

handle_info(_Info, S) ->
    io:format("SMTPC: Info - '~p'~n",[_Info]),
    enable_flow(S),
    {noreply, S}
.

%%--------------------------------------------------------------------
%% Function: terminate(Reason, State) -> void()
%% Description: This function is called by a gen_server when it is about to
%% terminate. It should be the opposite of Module:init/1 and do any necessary
%% cleaning up. When it returns, the gen_server terminates with Reason.
%% The return value is ignored.
%%--------------------------------------------------------------------
terminate(_Reason, S) ->
io:format("gen_server stopped: ~p~n~p~n",[_Reason, S]),
    ok.

%%--------------------------------------------------------------------
%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
%% Description: Convert process state when code is changed
%%--------------------------------------------------------------------
code_change(_OldVsn, State, _Extra) ->
    {ok, State}.

%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------

close_port(S)
  when S#s.port =/= {} ->
    {Mod, Port} = S#s.port,
    Mod:close(Port)
;

close_port(_) ->
    ok
.


plain_encode(User, Password) ->
    base64:encode(lists:flatten([User, "\0", User, "\0", Password]))
.

intersect(A, {ok, B})
  when is_list(A), is_list(B) ->
    [X || X <- A, Y <- B, X =:= Y]
;
intersect(_, _) -> 
    []
.

send(S, Data) ->
    {Mod, Port} = S#s.port,
    Mod:send(Port, Data) =/= ok andalso ?GENEVENT(close_connection)
.

enable_flow(S)
  when S#s.port =/= {} ->
    element(1,S#s.port) =:= ssl andalso ssl:setopts(element(2,S#s.port), [{active, once}]),
    element(1,S#s.port) =:= gen_tcp andalso inet:setopts(element(2,S#s.port), [{active, once}])
.

get_dest_mx(Dest) ->
    case inet_res:getbyname(Dest, mx) of
	{ok, R} ->
	    F = fun(X, Y) ->
			element(1,X) =< element(1,Y)
		end,
	    L = lists:sort(F, R#hostent.h_addr_list),
	    L1 = [Y || {_X, Y} <- L],
	    {ok, L1};
	{error, _} ->
	    case inet_res:getbyname(Dest,a) of
		{error, _} ->
		    false;
		{ok, Dr} ->
		    Dr#hostent.h_addr_list
	    end
    end
.

parse_ehlo(S)
  when is_record(S, s) ->
    S#s{attr = parse_ehlo(S#s.attr, S#s.data)}
.

parse_ehlo(S,[]) ->
    S
;

parse_ehlo(S, [H|T]) ->
    D = string:tokens(H, " \n\r"),
    try
	case string:to_lower(lists:nth(1,D)) of
	    "size" ->
		Sn = dict:store(size, erlang:list_to_integer(lists:nth(2,D)), S),
		parse_ehlo(Sn, T);
	    "auth"  ->
		[ _ | SupAuth] = D,
		F = fun(X) ->
			    list_to_atom(string:to_lower(X))
		    end,
		Sa = lists:map(F, SupAuth),
		Sn = dict:store(auth, Sa, S),
		parse_ehlo(Sn, T);
	    _ ->
		parse_ehlo(S, T)
	end
    catch
	_:_ ->
	    parse_ehlo(S, T)
    end
;

parse_ehlo(S, _) ->
    S
.

parse_data(S, D) ->
    case D of
	<<$\r, $\n>> -> % do nothing
	    Sn = S#s{rc = "", data = []};

	<<Rcb:3/binary, $-, Datab/binary>> -> % Part of ansver
	    Data = string:strip(string:tokens(binary_to_list(Datab),"\r\n")),
	    Sn = S#s{rc = Rcb, data = lists:append(S#s.data, Data)};
	
	<<Rcb:3/binary, 32, Datab/binary>> -> % Server ansver
	    Data = string:strip(string:tokens(binary_to_list(Datab),"\r\n")),
	    Sn =  S#s{rc = Rcb, data = lists:append(S#s.data, Data)},
	    Rcl = binary_to_list(Rcb),
	    Rc = case Rcl of
		     [$2,_,_]   -> ok;
		     "354"      -> ok;
		     "334"      -> ok;
		     [$3, _, _] -> temperr;
%		     "421"      -> tempclose;
		     [$4, _, _] -> temperr;
		     [$5, _, _] -> permerr;
		     _          -> permerr
		 end,
	    case Rc of
%		tempclose -> ?GENEVENT(close_connection);
		permerr   -> ?GENEVENT(permanent_error);
		temperr   -> ?GENEVENT(temporary_error);
		ok        -> ?EVENT({ok, Rcl, Sn#s.data})
	    end;

	<<Any/binary>> -> % Some trash
	    Sn = S#s{rc = "", data = []},
	    io:format("Unknown data:~p~n", [Any])
    end,
    Sn
.
